Imports System
Imports System.Net
Imports System.IO
Imports System.Text
Imports System.Net.Sockets

Namespace persistent.FTP

    Public Class FtpStream
        Inherits System.Net.Sockets.NetworkStream
        Private _FtpStreamer As FTPStreamer = FTPStreamer.Providers.Pop()

        Sub New(ByVal remoteHost As String, ByVal userName As String, ByVal password As String, ByVal remoteFilePath As String, ByVal streamMode As FtpStreamingMode, Optional ByVal remotePort As Integer = 21)
            MyBase.New(New FTPStreamer(remoteHost, FtpStream.getPath(remoteFilePath), userName, password, remotePort).CreateSocketForStream(FtpStream.getFileName(remoteFilePath), streamMode), streamMode, True)
        End Sub

        Public Overrides Sub Flush()
            MyBase.Flush()
        End Sub

        Public Overrides Function Read(ByVal buffer() As Byte, ByVal offset As Integer, ByVal count As Integer) As Integer
            Try
                Return MyBase.Read(buffer, offset, count)
            Catch ex As Exception
                Throw New FtpStreamException(ex.Message, ex)
            End Try
        End Function

        Public Overrides Function Seek(ByVal offset As Long, ByVal origin As System.IO.SeekOrigin) As Long
            MyBase.Seek(offset, origin)
        End Function

        Public Overrides Sub SetLength(ByVal value As Long)
            MyBase.SetLength(value)
        End Sub

        Public Overrides Sub Write(ByVal buffer() As Byte, ByVal offset As Integer, ByVal count As Integer)
            Try
                MyBase.Write(buffer, offset, count)
            Catch ex As Exception
                Throw New FtpStreamException(ex.Message, ex)
            End Try
        End Sub

        Public Overrides Sub Close()
            MyBase.Close()
            Me._FtpStreamer.Dispose()
        End Sub

        Private Shared Function getPath(ByVal filePath As String) As String
            Dim _filePath As String = System.Text.RegularExpressions.Regex.Replace(filePath, "/+", "/")
            If (_filePath.LastIndexOf("/") < 1) Then
                Return ""
            End If
            Return _filePath.Substring(0, _filePath.LastIndexOf("/"))
        End Function

        Private Shared Function getFileName(ByVal filePath As String) As String
            Dim _filePath As String = System.Text.RegularExpressions.Regex.Replace(filePath, "/+", "/")
            If (_filePath.LastIndexOf("/") < 1) Then
                Return _filePath
            End If
            Return _filePath.Substring(_filePath.LastIndexOf("/") + 1)
        End Function

        Private Class FTPStreamer

            Private m_sRemoteHost, m_sRemotePath, m_sRemoteUser As String
            Private m_sRemotePassword, m_sMess As String
            Private m_iRemotePort, m_iBytes As Int32
            Private m_objClientSocket As Socket

            Private m_iRetValue As Int32
            Private m_bLoggedIn As Boolean    ' Change to loggedIn
            Private m_sMes, m_sReply As String

            ' Set the size of the packet that is used to read and
            '  write data to the FTP Server to the spcified size below.
            Public Const BLOCK_SIZE = 512
            Private m_aBuffer(BLOCK_SIZE) As Byte
            Private ASCII As Encoding = Encoding.ASCII

            ' General variables
            Private m_sMessageString As String

            Private Shared _Providers As New Collections.Stack
            Public Shared ReadOnly Property Providers() As Collections.Stack
                Get
                    Return _Providers
                End Get
            End Property

            Public Sub New(ByVal sRemoteHost As String, ByVal sRemotePath As String, ByVal sRemoteUser As String, ByVal sRemotePassword As String, ByVal iRemotePort As Int32)
                m_sRemoteHost = sRemoteHost
                m_sRemotePath = sRemotePath
                m_sRemoteUser = sRemoteUser
                m_sRemotePassword = sRemotePassword
                m_sMessageString = ""
                m_iRemotePort = iRemotePort
                m_bLoggedIn = False
                Providers.Push(Me)
            End Sub

            Public Function CreateSocketForStream(ByVal sFileName As String, ByVal streamMode As FtpStreamingMode) As Socket
                Dim cSocket As Socket

                If (Not (m_bLoggedIn)) Then
                    Login()
                End If

                SetBinaryMode(True)

                cSocket = CreateDataSocket()

                If streamMode = FtpStreamingMode.Read Then
                    SendCommand("RETR " & sFileName)
                Else
                    SendCommand("STOR " & Path.GetFileName(sFileName))
                End If

                If (Not (m_iRetValue = 125 Or m_iRetValue = 150)) Then
                    Throw New FtpStreamException(m_sReply.Substring(4), Nothing)
                End If

                Return cSocket

            End Function

            Private Function Login() As Boolean
                m_objClientSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
                Dim ep As New IPEndPoint(Dns.Resolve(m_sRemoteHost).AddressList(0), m_iRemotePort)

                Try
                    m_objClientSocket.Connect(ep)
                Catch ex As Exception
                    Throw New FtpConnectionException("Couldn't connect to remote server!", ex)
                End Try

                ReadReply()
                If (m_iRetValue <> 220) Then
                    CloseConnection()
                    Throw New FtpConnectionException(m_sReply.Substring(4), Nothing)
                End If

                SendCommand("USER " & m_sRemoteUser)
                If (Not (m_iRetValue = 331 Or m_iRetValue = 230)) Then
                    Cleanup()
                    Throw New FtpConnectionException(m_sReply.Substring(4), Nothing)
                End If

                If (m_iRetValue <> 230) Then
                    SendCommand("PASS " & m_sRemotePassword)
                    If (Not (m_iRetValue = 230 Or m_iRetValue = 202)) Then
                        Cleanup()
                        Throw New FtpConnectionException(m_sReply.Substring(4), Nothing)
                    End If
                End If

                m_bLoggedIn = True
                ChangeDirectory(m_sRemotePath)

                ' Return the end result.
                Return m_bLoggedIn
            End Function

            Private Sub SetBinaryMode(ByVal bMode As Boolean)

                If (bMode) Then
                    SendCommand("TYPE I")
                Else
                    SendCommand("TYPE A")
                End If

                If (m_iRetValue <> 200) Then
                    Throw New IOException(m_sReply.Substring(4))
                End If
            End Sub

            Private Sub ReadReply()
                m_sMes = ""
                m_sReply = ReadLine()
                m_iRetValue = Int32.Parse(m_sReply.Substring(0, 3))
            End Sub

            Private Sub Cleanup()
                If Not (m_objClientSocket Is Nothing) Then
                    m_objClientSocket.Close()
                    m_objClientSocket = Nothing
                End If

                m_bLoggedIn = False
            End Sub

            Private Function ReadLine(Optional ByVal bClearMes As Boolean = False) As String
                Dim seperator As Char = ControlChars.Lf
                Dim mess() As String

                If (bClearMes) Then
                    m_sMes = ""
                End If
                Do While (True)
                    m_aBuffer.Clear(m_aBuffer, 0, BLOCK_SIZE)
                    m_iBytes = m_objClientSocket.Receive(m_aBuffer, m_aBuffer.Length, 0)
                    m_sMes += ASCII.GetString(m_aBuffer, 0, m_iBytes)
                    If (m_iBytes < m_aBuffer.Length) Then
                        Exit Do
                    End If
                Loop

                mess = m_sMes.Split(seperator)
                If (m_sMes.Length > 2) Then
                    m_sMes = mess(mess.Length - 2)
                Else
                    m_sMes = mess(0)
                End If

                If (Not (m_sMes.Substring(3, 1).Equals(" "))) Then
                    Return ReadLine(True)
                End If

                Return m_sMes
            End Function

            Private Sub SendCommand(ByVal sCommand As String)
                sCommand = sCommand & ControlChars.CrLf
                Dim cmdbytes As Byte() = ASCII.GetBytes(sCommand)

                m_objClientSocket.Send(cmdbytes, cmdbytes.Length, 0)
                ReadReply()
            End Sub

            Private Function CreateDataSocket() As Socket
                Dim index1, index2, len As Int32
                Dim partCount, i, port As Int32
                Dim ipData, buf, ipAddress As String
                Dim parts(6) As Int32
                Dim ch As Char
                Dim ep As IPEndPoint
                Dim s As Socket

                SendCommand("PASV")
                If (m_iRetValue <> 227) Then
                    Throw New FtpStreamException(m_sReply.Substring(4), Nothing)
                End If

                index1 = m_sReply.IndexOf("(")
                index2 = m_sReply.IndexOf(")")
                ipData = m_sReply.Substring(index1 + 1, index2 - index1 - 1)

                len = ipData.Length
                partCount = 0
                buf = ""

                For i = 0 To ((len - 1) And partCount <= 6)
                    ch = Char.Parse(ipData.Substring(i, 1))
                    If (Char.IsDigit(ch)) Then
                        buf += ch
                    ElseIf (ch <> ",") Then
                        Throw New FtpStreamException("Malformed PASV reply: " & m_sReply, Nothing)
                    End If

                    If ((ch = ",") Or (i + 1 = len)) Then
                        Try
                            parts(partCount) = Int32.Parse(buf)
                            partCount += 1
                            buf = ""
                        Catch ex As Exception
                            Throw New FtpStreamException("Malformed PASV reply: " & m_sReply, Nothing)
                        End Try
                    End If
                Next

                ipAddress = parts(0) & "." & parts(1) & "." & parts(2) & "." & parts(3)

                ' Make this call in VB.NET 2002.  We would like to 
                '  bitshift the number by 8 bits, so in VB.NET 2002 we
                '  multiply the number by 2 to the power of 8.
                port = parts(4) * (2 ^ 8)

                ' Make this call and comment out the above line for
                '  VB.NET 2003.
                'port = parts(4) << 8

                ' Determine the data port number.
                port = port + parts(5)

                s = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
                ep = New IPEndPoint(Dns.Resolve(ipAddress).AddressList(0), port)

                Try
                    s.Connect(ep)
                Catch ex As Exception
                    Throw New FtpConnectionException("Can't connect to remote server!", ex)
                End Try

                Return s
            End Function

            Private Function ChangeDirectory(ByVal sDirName As String) As Boolean
                Dim bResult As Boolean

                bResult = True
                If (sDirName.Equals(".")) Then
                    Exit Function
                End If

                If (Not (m_bLoggedIn)) Then
                    Login()
                End If

                SendCommand("CWD " & sDirName)
                If (m_iRetValue <> 250) Then
                    bResult = False
                End If

                Me.m_sRemotePath = sDirName

                ' Return the final result.
                Return bResult
            End Function

            Private Sub CloseConnection()
                If (Not (m_objClientSocket Is Nothing)) Then
                    SendCommand("QUIT")
                End If

                Cleanup()
            End Sub

            Public Sub Dispose()
                Me.CloseConnection()
            End Sub
        End Class

    End Class


    Public Enum FtpStreamingMode
        Read = FileAccess.Read
        Write = FileAccess.Write
    End Enum

    Public Class FtpConnectionException
        Inherits Exception

        Public Sub New(ByVal message As String, ByVal innerException As Exception)
            MyBase.New(message, innerException)
        End Sub
    End Class

    Public Class FtpStreamException
        Inherits Exception

        Public Sub New(ByVal message As String, ByVal innerException As Exception)
            MyBase.New(message, innerException)
        End Sub
    End Class
End Namespace


